home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cocktail / rpp.lha / rpp / src / Scanner.mi < prev    next >
Text File  |  1992-08-18  |  24KB  |  975 lines
  1. (* $Id: Scanner.mi,v 2.10 1992/08/18 09:05:32 grosch rel $ *)
  2.  
  3. IMPLEMENTATION MODULE Scanner;
  4.  
  5. IMPORT SYSTEM, Checks, System, General, Positions, IO, DynArray, Strings, Source;
  6. (* line 9 "rpp.rex" *)
  7.  
  8. FROM    System        IMPORT    GetArgument,    GetArgCount;
  9. FROM    Strings        IMPORT    tString,    AssignEmpty,    Append,
  10.                 Concatenate,    Length,        Char,
  11.                 IntToString,    StringToArray,    WriteS,
  12.                 ReadL,        WriteL,        IsEqual,
  13.                 ArrayToString;
  14. FROM    StringMem    IMPORT    tStringRef,    PutString,    GetString;
  15. FROM    Idents        IMPORT    tIdent,        NoIdent,    MakeIdent,
  16.                 MaxIdent,    InitIdents;
  17. FROM     IO        IMPORT    StdInput,    StdOutput,    StdError,
  18.                 tFile,        ReadOpen,    ReadClose,
  19.                 ReadI,        ReadC,        WriteC,
  20.                 WriteI,        WriteNl,    EndOfFile,
  21.                 CloseIO;
  22.  
  23. CONST    MissingInfo    = "rpp: cannot access file <Scanner>.rpp";
  24.  
  25. VAR    Level        : CARDINAL;
  26.     StartString    : tString;
  27.     TheWord        : tString;
  28.     IsCollecting    : BOOLEAN;
  29.     BothFlag    : BOOLEAN;
  30.     Returning    : BOOLEAN;
  31.     InsText        : tString;
  32.     InfoFile    : tFile;
  33.     LastIdent    : tIdent;
  34.     TokenCode    : ARRAY [0..1023] OF SHORTCARD;
  35.     TokenSelector    : ARRAY [0..1023] OF tStringRef;
  36.     Not1, Not2, Not3: tString;
  37.     Any1, Any2, Any3: tString;
  38.     Argument    : ARRAY [0 .. 127] OF CHAR;
  39.     i        : SHORTCARD;
  40.     Language    : (Modula, C);
  41.  
  42. PROCEDURE Skip;
  43. BEGIN
  44.   REPEAT
  45.     ReadL (InfoFile, TheWord);
  46.   UNTIL (Length (TheWord) = 2) AND (Char (TheWord, 1) = '%') AND (Char (TheWord, 2) = '%');
  47. END Skip;
  48.  
  49. PROCEDURE DoText;
  50. BEGIN
  51.   IF NOT IsCollecting THEN yyEcho;
  52.   ELSIF Level > 0 THEN GetWord (TheWord); Concatenate (InsText, TheWord);
  53.   END;
  54. END DoText;
  55.  
  56. PROCEDURE DoIdent;
  57. VAR i: tIdent;
  58. BEGIN
  59.   GetWord (TheWord);
  60.   i := MakeIdent (TheWord);
  61.   IF i <= LastIdent THEN
  62.     IF Returning THEN
  63.       IntToString (TokenCode [i], TheWord);
  64.     ELSE
  65.       GetString (TokenSelector [i], TheWord);
  66.     END;
  67.     IF IsCollecting THEN
  68.       Concatenate (InsText, TheWord);
  69.     ELSE
  70.       WriteS (StdOutput, TheWord);
  71.     END;
  72.   ELSE
  73.     IF IsCollecting THEN
  74.       Concatenate (InsText, TheWord);
  75.     ELSE
  76.       yyEcho;
  77.     END;
  78.   END;
  79. END DoIdent;
  80.  
  81. PROCEDURE CopyText;
  82. BEGIN
  83.   LOOP
  84.     ReadL (InfoFile, TheWord);
  85.     IF (Length (TheWord) = 2) AND (Char (TheWord, 1) = '%') AND (Char (TheWord, 2) = '%') THEN EXIT; END;
  86.     WriteL (StdOutput, TheWord);
  87.   END;
  88. END CopyText;
  89.  
  90. PROCEDURE GenPosition;
  91. BEGIN
  92.   CASE Language OF
  93.   | Modula: IO.WriteS (StdOutput, "FROM Positions IMPORT tPosition;");
  94.   | C      : IO.WriteS (StdOutput, '# include "Positions.h"');
  95.   ELSE
  96.   END;
  97.   WriteNl (StdOutput);
  98. END GenPosition;
  99.  
  100. PROCEDURE GenScanAttr;
  101. BEGIN
  102.   InfoFile := ReadOpen (InfoFileName);
  103.   ReadL (InfoFile, TheWord);
  104.   CopyText;
  105.   ReadClose (InfoFile);
  106. END GenScanAttr;
  107.  
  108. PROCEDURE GenErrorAttr;
  109. BEGIN
  110.   InfoFile := ReadOpen (InfoFileName);
  111.   Skip;
  112.   CopyText;
  113.   ReadClose (InfoFile);
  114. END GenErrorAttr;
  115.  
  116. PROCEDURE ReadIdents;
  117. VAR    t, i    : INTEGER;
  118.     c    : CHAR;
  119.     Ident    : tIdent;
  120.     Selector: ARRAY [0..255] OF CHAR;
  121.     String    : tString;
  122. BEGIN
  123.   InfoFile := ReadOpen (InfoFileName);
  124.   IF InfoFile < 0 THEN
  125.      IO.WriteS (StdError, MissingInfo); WriteNl (StdError); CloseIO; HALT;
  126.   END;
  127.   ReadL (InfoFile, TheWord);
  128.   CASE Char (TheWord, 1) OF
  129.   | 'm' : Language := Modula;
  130.   | 'c' : Language := C;
  131.   ELSE
  132.   END;
  133.   Skip;
  134.   Skip;
  135.   WHILE NOT EndOfFile (InfoFile) DO
  136.     t := ReadI (InfoFile);
  137.     c := ReadC (InfoFile);
  138.     c := ReadC (InfoFile);
  139.     c := ReadC (InfoFile);
  140.     i := 0;
  141.     REPEAT
  142.        Selector [i] := ReadC (InfoFile);
  143.        INC (i);
  144.     UNTIL Selector [i-1] = ' ';
  145.     Selector [i-1] := 0C;
  146.     ArrayToString (Selector, String);
  147.     ReadL (InfoFile, TheWord);
  148.     Ident := MakeIdent (TheWord);
  149.     TokenCode [Ident] := t;
  150.     TokenSelector [Ident] := PutString (String);
  151.   END;
  152.   ReadClose (InfoFile);
  153.   LastIdent := MaxIdent ();
  154. END ReadIdents;
  155.  
  156. PROCEDURE InsertRules;
  157. VAR    Code    : CARDINAL;
  158.     c, Ch    : CHAR;
  159.     Selector: ARRAY [0..255] OF CHAR;
  160.     i    : CARDINAL;
  161.  
  162.   PROCEDURE WriteIdent (VAR TheWord : tString);
  163.   VAR    s    : ARRAY [0..255] OF CHAR;
  164.     j    : CARDINAL;
  165.   BEGIN
  166.     StringToArray (TheWord, s);
  167.     s [Length (TheWord)] := "'";
  168.     IF NOT BothFlag AND (
  169.        IsEqual (TheWord, Not1) OR IsEqual (TheWord, Not2) OR IsEqual (TheWord, Not3) OR
  170.        IsEqual (TheWord, Any1) OR IsEqual (TheWord, Any2) OR IsEqual (TheWord, Any3)) THEN
  171.       WriteC (StdOutput, "\");
  172.     END;
  173.     IF (s [0] = "'") OR (s [0] = '"') THEN j := 1; ELSE j := 0; END;
  174.     REPEAT
  175.       IF BothFlag THEN
  176.         CASE s [j] OF
  177.       'a'..'z' :
  178.         WriteC (StdOutput, "{");
  179.         WriteC (StdOutput, s [j]);
  180.         WriteC (StdOutput, CAP (s [j]));
  181.         WriteC (StdOutput, "}");
  182.     | 'A'..'Z' :
  183.         WriteC (StdOutput, "{");
  184.         WriteC (StdOutput, CHR (ORD (s [j]) - ORD ('A') + ORD ('a')));
  185.         WriteC (StdOutput, s [j]);
  186.         WriteC (StdOutput, "}");
  187.     | '0'..'9', '_' :
  188.         WriteC (StdOutput, s [j]);
  189.     ELSE
  190.       WriteC (StdOutput, "\");
  191.       WriteC (StdOutput, s [j]);
  192.     END;
  193.       ELSE
  194.     CASE s [j] OF
  195.       '0'..'9', 'A'..'Z', 'a'..'z', '_' : WriteC (StdOutput, s [j]);
  196.     ELSE
  197.       WriteC (StdOutput, "\");
  198.       WriteC (StdOutput, s [j]);
  199.     END;
  200.       END;
  201.       INC (j);
  202.     UNTIL (s [j] = '"') OR (s [j] = "'");
  203.   END WriteIdent;
  204.  
  205. BEGIN
  206.   InfoFile := ReadOpen (InfoFileName);
  207.   Skip;
  208.   Skip;
  209.   WHILE NOT EndOfFile (InfoFile) DO
  210.     Code := ReadI (InfoFile);
  211.     c := ReadC (InfoFile);
  212.     Ch := ReadC (InfoFile);
  213.     c := ReadC (InfoFile);
  214.     i := 0;
  215.     REPEAT
  216.        Selector [i] := ReadC (InfoFile);
  217.        INC (i);
  218.     UNTIL Selector [i-1] = ' ';
  219.     Selector [i-1] := 0C;
  220.     ReadL (InfoFile, TheWord);
  221.     IF Ch # 'S' THEN
  222.        WriteS (StdOutput, StartString);
  223.        WriteIdent (TheWord);
  224.        WriteC (StdOutput, 11C);
  225.        IO.WriteS (StdOutput, ": { ");
  226.        WriteS (StdOutput, InsText);
  227.        CASE Language OF
  228.        | Modula    : IO.WriteS (StdOutput, "RETURN ");
  229.        | C    : IO.WriteS (StdOutput, "return ");
  230.        END;
  231.        WriteI (StdOutput, Code, 0);
  232.        IO.WriteS (StdOutput, "; }");
  233.        WriteNl (StdOutput);
  234.      END;
  235.   END;
  236.   ReadClose (InfoFile);
  237. END InsertRules;
  238.  
  239.  
  240. CONST
  241.    yyTabSpace        = 8;
  242.    yyDNoState        = 0;
  243.    yyFileStackSize    = 16;
  244.    yyInitBufferSize    = 1024 * 8 + 256;
  245. yyFirstCh    = 0C;
  246. yyLastCh    = 177C;
  247. yyEolCh    = 12C;
  248. yyEobCh    = 177C;
  249. yyDStateCount    = 154;
  250. yyTableSize    = 1254;
  251. yyEobState    = 132;
  252. yyDefaultState    = 133;
  253. STD    = 1;
  254. Return    = 3;
  255. Start    = 5;
  256. Action    = 7;
  257. Rules    = 9;
  258. Set    = 11;
  259.  
  260. TYPE
  261.    yyTableElmt        = SHORTCARD;
  262.    yyStateRange        = yyTableElmt [0 .. yyDStateCount];
  263.    yyTableRange        = yyTableElmt [0 .. yyTableSize];
  264.    yyCombType        = RECORD Check, Next: yyStateRange; END;
  265.    yyCombTypePtr    = POINTER TO yyCombType;
  266.    yytChBufferPtr    = POINTER TO ARRAY [0 .. 1000000] OF CHAR;
  267.    yyChRange        = [yyFirstCh .. yyLastCh];
  268.  
  269. VAR
  270.    yyBasePtr        : ARRAY yyStateRange    OF LONGCARD    ;
  271.    yyDefault        : ARRAY yyStateRange    OF yyStateRange    ;
  272.    yyComb        : ARRAY yyTableRange    OF yyCombType    ;
  273.    yyEobTrans        : ARRAY yyStateRange    OF yyStateRange    ;
  274.    yyToLower, yyToUpper    : ARRAY yyChRange    OF CHAR        ;
  275.  
  276.    yyStateStack        : POINTER TO ARRAY [0 .. 1000000] OF yyStateRange;
  277.    yyStateStackSize    : LONGINT;
  278.    yyStartState        : yyStateRange;
  279.    yyPreviousStart    : yyStateRange;
  280.    yyCh            : CHAR;
  281.  
  282.    yySourceFile        : System.tFile;
  283.    yyEof        : BOOLEAN;
  284.    yyChBufferPtr    : yytChBufferPtr;
  285.    yyChBufferStart    : INTEGER;
  286.    yyChBufferSize    : LONGINT;
  287.    yyChBufferIndex    : INTEGER;
  288.    yyBytesRead        : INTEGER;
  289.    yyLineCount        : CARDINAL;
  290.    yyLineStart        : INTEGER;
  291.  
  292.    yyFileStackPtr    : SHORTCARD;
  293.    yyFileStack        : ARRAY [1 .. yyFileStackSize] OF RECORD
  294.                     SourceFile        : System.tFile;
  295.                  Eof        : BOOLEAN;
  296.                     ChBufferPtr    : yytChBufferPtr;
  297.                  ChBufferStart    : INTEGER;
  298.                  ChBufferSize    : LONGINT;
  299.                     ChBufferIndex    : INTEGER;
  300.                     BytesRead        : INTEGER;
  301.                     LineCount        : CARDINAL;
  302.                     LineStart        : INTEGER;
  303.               END;
  304.  
  305. PROCEDURE GetToken (): INTEGER;
  306.    VAR
  307.       yyState        : yyStateRange;
  308.       yyTablePtr    : yyCombTypePtr;
  309.       yyRestartFlag    : BOOLEAN;
  310.       yyi, yySource, yyTarget, yyChBufferFree    : INTEGER;
  311. BEGIN
  312.    LOOP
  313.       yyState        := yyStartState;
  314.       TokenLength     := 0;
  315.  
  316.       (* ASSERT yyChBuffer [yyChBufferIndex] = first character *)
  317.  
  318.       LOOP        (* eventually restart after sentinel *)
  319.      LOOP        (* execute as many state transitions as possible *)
  320.                             (* determine next state *)
  321.         yyTablePtr := yyCombTypePtr (yyBasePtr [yyState] +
  322.            ORD (yyChBufferPtr^ [yyChBufferIndex]) * SYSTEM.TSIZE (yyCombType));
  323.         IF yyTablePtr^.Check # yyState THEN
  324.            yyState := yyDefault [yyState];
  325.            IF yyState = yyDNoState THEN EXIT; END;
  326.         ELSE
  327.            yyState := yyTablePtr^.Next;
  328.            INC (TokenLength);
  329.            yyStateStack^ [TokenLength] := yyState;    (* push state *)
  330.            INC (yyChBufferIndex);        (* get next character *)
  331.         END;
  332.      END;
  333.  
  334.      LOOP                    (* search for last final state *)
  335. CASE yyStateStack^ [TokenLength] OF
  336. |154
  337. :
  338. (* line 271 "rpp.rex" *)
  339.  yyStart (Action); yyEcho; Level := 1; 
  340. yyRestartFlag := FALSE; EXIT;
  341. |29
  342. :
  343. (* line 272 "rpp.rex" *)
  344.  yyStart (Rules); yyEcho; 
  345. yyRestartFlag := FALSE; EXIT;
  346. |19
  347. :
  348. (* line 274 "rpp.rex" *)
  349.  DoText; 
  350. yyRestartFlag := FALSE; EXIT;
  351. |17
  352. :
  353. (* line 275 "rpp.rex" *)
  354.  yyStart (Start); BothFlag := FALSE; 
  355. yyRestartFlag := FALSE; EXIT;
  356. |18
  357. :
  358. (* line 276 "rpp.rex" *)
  359.  yyStart (Start); BothFlag := TRUE; 
  360. yyRestartFlag := FALSE; EXIT;
  361. |15
  362. ,39
  363. :
  364. (* line 277 "rpp.rex" *)
  365.  yyStart (Action); yyEcho; Level := 0; 
  366. yyRestartFlag := FALSE; EXIT;
  367. |153
  368. :
  369. (* line 278 "rpp.rex" *)
  370.  yyStart (Set); yyEcho; 
  371. yyRestartFlag := FALSE; EXIT;
  372. |152
  373. :
  374. (* line 280 "rpp.rex" *)
  375.  yyPrevious; yyEcho; 
  376. yyRestartFlag := FALSE; EXIT;
  377. |151
  378. :
  379. (* line 282 "rpp.rex" *)
  380.  yyPrevious; InsertRules; 
  381. yyRestartFlag := FALSE; EXIT;
  382. |24
  383. :
  384. (* line 283 "rpp.rex" *)
  385.  yyPrevious; GetWord (StartString); InsertRules; 
  386. yyRestartFlag := FALSE; EXIT;
  387. |25
  388. :
  389. WHILE yyStateStack^ [TokenLength] # 
  390. 24 DO
  391.    DEC (yyChBufferIndex);
  392.    DEC (TokenLength);
  393. END;
  394. (* line 284 "rpp.rex" *)
  395.  GetWord (StartString);
  396.                  yyStartState := Action; Level := 0; IsCollecting := TRUE; 
  397. yyRestartFlag := FALSE; EXIT;
  398. |26
  399. :
  400. DEC (yyChBufferIndex, 1);
  401. DEC (TokenLength, 1);
  402. (* line 286 "rpp.rex" *)
  403.  yyStartState := Action; Level := 0; IsCollecting := TRUE; 
  404. yyRestartFlag := FALSE; EXIT;
  405. |22
  406. :
  407. (* line 288 "rpp.rex" *)
  408.  GenPosition; 
  409. yyRestartFlag := FALSE; EXIT;
  410. |21
  411. :
  412. (* line 289 "rpp.rex" *)
  413.  GenScanAttr; 
  414. yyRestartFlag := FALSE; EXIT;
  415. |23
  416. :
  417. (* line 290 "rpp.rex" *)
  418.  GenErrorAttr; 
  419. yyRestartFlag := FALSE; EXIT;
  420. |150
  421. :
  422. (* line 292 "rpp.rex" *)
  423.  DoText; INC (Level); 
  424. yyRestartFlag := FALSE; EXIT;
  425. |149
  426. :
  427. (* line 293 "rpp.rex" *)
  428.  DEC (Level);
  429.                          IF Level > 0 THEN
  430.                            DoText;
  431.                          ELSE
  432.                            yyPrevious;
  433.                            IF IsCollecting THEN
  434.                          InsertRules; IsCollecting := FALSE;
  435.                            ELSE
  436.                          yyEcho;
  437.                            END;
  438.                          END; 
  439. yyRestartFlag := FALSE; EXIT;
  440. |148
  441. :
  442. (* line 305 "rpp.rex" *)
  443.  yyStartState := Return; DoText; Returning := FALSE; 
  444. yyRestartFlag := FALSE; EXIT;
  445. |20
  446. :
  447. (* line 306 "rpp.rex" *)
  448.  yyStartState := Return; DoText; Returning := TRUE; 
  449. yyRestartFlag := FALSE; EXIT;
  450. |27
  451. :
  452. (* line 308 "rpp.rex" *)
  453.  yyStartState := Action; DoIdent; 
  454. yyRestartFlag := FALSE; EXIT;
  455. |28
  456. :
  457. (* line 309 "rpp.rex" *)
  458.  yyStartState := Action; DoIdent; 
  459. yyRestartFlag := FALSE; EXIT;
  460. |13
  461. ,30
  462. ,31
  463. ,32
  464. ,33
  465. ,34
  466. ,35
  467. ,36
  468. ,37
  469. ,48
  470. ,49
  471. ,65
  472. ,116
  473. ,117
  474. ,130
  475. ,135
  476. ,136
  477. ,137
  478. ,138
  479. ,139
  480. :
  481. (* line 311 "rpp.rex" *)
  482.  DoText; 
  483. yyRestartFlag := FALSE; EXIT;
  484. |14
  485. ,38
  486. :
  487. (* line 311 "rpp.rex" *)
  488.  DoText; 
  489. yyRestartFlag := FALSE; EXIT;
  490. |134
  491. :
  492. (* line 311 "rpp.rex" *)
  493.  DoText; 
  494. yyRestartFlag := FALSE; EXIT;
  495. |1
  496. ,2
  497. ,3
  498. ,4
  499. ,5
  500. ,6
  501. ,7
  502. ,8
  503. ,9
  504. ,10
  505. ,11
  506. ,12
  507. ,16
  508. ,40
  509. ,41
  510. ,42
  511. ,43
  512. ,44
  513. ,45
  514. ,46
  515. ,47
  516. ,50
  517. ,51
  518. ,52
  519. ,53
  520. ,54
  521. ,55
  522. ,56
  523. ,57
  524. ,58
  525. ,59
  526. ,60
  527. ,61
  528. ,62
  529. ,63
  530. ,64
  531. ,66
  532. ,67
  533. ,68
  534. ,69
  535. ,70
  536. ,71
  537. ,72
  538. ,73
  539. ,74
  540. ,75
  541. ,76
  542. ,77
  543. ,78
  544. ,79
  545. ,80
  546. ,81
  547. ,82
  548. ,83
  549. ,84
  550. ,85
  551. ,86
  552. ,87
  553. ,88
  554. ,89
  555. ,90
  556. ,91
  557. ,92
  558. ,93
  559. ,94
  560. ,95
  561. ,96
  562. ,97
  563. ,98
  564. ,99
  565. ,100
  566. ,101
  567. ,102
  568. ,103
  569. ,104
  570. ,105
  571. ,106
  572. ,107
  573. ,108
  574. ,109
  575. ,110
  576. ,111
  577. ,112
  578. ,113
  579. ,114
  580. ,115
  581. ,118
  582. ,119
  583. ,120
  584. ,121
  585. ,122
  586. ,123
  587. ,124
  588. ,125
  589. ,126
  590. ,127
  591. ,128
  592. ,129
  593. ,131
  594. ,140
  595. ,141
  596. ,142
  597. ,143
  598. ,144
  599. ,145
  600. ,146
  601. ,147
  602. :
  603.         (* non final states *)
  604.           DEC (yyChBufferIndex);    (* return character *)
  605.           DEC (TokenLength)        (* pop state *)
  606.  
  607. | 133:
  608.           Attribute.Position.Line   := yyLineCount;
  609.           Attribute.Position.Column := yyChBufferIndex - yyLineStart;
  610.           INC (yyChBufferIndex);
  611.           TokenLength := 1;
  612. IO.WriteC (IO.StdOutput, yyChBufferPtr^ [yyChBufferIndex-1]);
  613.               yyRestartFlag := FALSE; EXIT;
  614.  
  615.         |  yyDNoState    :        (* automatic initialization *)
  616.           yyGetTables;
  617.           yyStateStack^ [0] := yyDefaultState; (* stack underflow sentinel *)
  618.           IF yyFileStackPtr = 0 THEN
  619.              yyInitialize;
  620.              yySourceFile := System.StdInput;
  621.           END;
  622.               yyRestartFlag := FALSE; EXIT;
  623.  
  624. | 132:
  625.           DEC (yyChBufferIndex);    (* undo last state transition *)
  626.           DEC (TokenLength);        (* get previous state *)
  627.           IF TokenLength = 0 THEN
  628.              yyState := yyStartState;
  629.           ELSE
  630.              yyState := yyStateStack^ [TokenLength];
  631.           END;
  632.  
  633.           IF yyChBufferIndex # yyChBufferStart + yyBytesRead THEN
  634.              yyState := yyEobTrans [yyState];    (* end of buffer sentinel in buffer *)
  635.              IF yyState # yyDNoState THEN
  636.             INC (yyChBufferIndex);
  637.             INC (TokenLength);
  638.             yyStateStack^ [TokenLength] := yyState;
  639.             yyRestartFlag := TRUE; EXIT;
  640.              END;
  641.           ELSE                (* end of buffer reached *)
  642.  
  643.              (* copy initial part of token in front of input buffer *)
  644.  
  645.              yySource := yyChBufferIndex - TokenLength - 1;
  646.              yyTarget := General.MaxAlign - TokenLength MOD General.MaxAlign - 1;
  647.              IF yySource # yyTarget THEN
  648.             FOR yyi := 1 TO TokenLength DO
  649.                yyChBufferPtr^ [yyTarget + yyi] := yyChBufferPtr^ [yySource + yyi];
  650.             END;
  651.             DEC (yyLineStart, yySource - yyTarget);
  652.             yyChBufferStart := yyTarget + TokenLength + 1;
  653.              ELSE
  654.             yyChBufferStart := yyChBufferIndex;
  655.              END;
  656.  
  657.              IF NOT yyEof THEN        (* read buffer and restart *)
  658.             yyChBufferFree := General.Exp2 (General.Log2 (yyChBufferSize - 4 - General.MaxAlign - TokenLength));
  659.             IF yyChBufferFree < yyChBufferSize DIV 8 THEN
  660.                DynArray.ExtendArray (yyChBufferPtr, yyChBufferSize, SYSTEM.TSIZE (CHAR));
  661.                IF yyChBufferPtr = NIL THEN yyErrorMessage (1); END;
  662.                yyChBufferFree := General.Exp2 (General.Log2 (yyChBufferSize - 4 - General.MaxAlign - TokenLength));
  663.                IF yyStateStackSize < yyChBufferSize THEN
  664.                   DynArray.ExtendArray (yyStateStack, yyStateStackSize, SYSTEM.TSIZE (yyStateRange));
  665.                   IF yyStateStack = NIL THEN yyErrorMessage (1); END;
  666.                END;
  667.             END;
  668.             yyChBufferIndex := yyChBufferStart;
  669.             yyBytesRead := Source.GetLine (yySourceFile, SYSTEM.ADR
  670.                (yyChBufferPtr^ [yyChBufferIndex]), yyChBufferFree);
  671.             IF yyBytesRead <= 0 THEN yyBytesRead := 0; yyEof := TRUE; END;
  672.             yyChBufferPtr^ [yyChBufferStart + yyBytesRead    ] := yyEobCh;
  673.             yyChBufferPtr^ [yyChBufferStart + yyBytesRead + 1] := 0C;
  674.             yyRestartFlag := TRUE; EXIT;
  675.              END;
  676.  
  677.              IF TokenLength = 0 THEN    (* end of file reached *)
  678.             Attribute.Position.Line   := yyLineCount;
  679.             Attribute.Position.Column := yyChBufferIndex - yyLineStart;
  680.             CloseFile;
  681.             IF yyFileStackPtr = 0 THEN
  682.             END;
  683.             IF yyFileStackPtr = 0 THEN RETURN EofToken; END;
  684.             yyRestartFlag := FALSE; EXIT;
  685.              END;
  686.           END;
  687.         ELSE
  688.            yyErrorMessage (0);
  689.         END;
  690.      END;
  691.      IF yyRestartFlag THEN ELSE EXIT; END;
  692.       END;
  693.    END;
  694.    END GetToken;
  695.  
  696. PROCEDURE BeginFile (FileName: ARRAY OF CHAR);
  697.    BEGIN
  698.       IF yyStateStack^ [0] = yyDNoState THEN    (* have tables been read in ? *)
  699.      yyGetTables;
  700.      yyStateStack^ [0] := yyDefaultState;    (* stack underflow sentinel *)
  701.       END;
  702.       yyInitialize;
  703.       yySourceFile := Source.BeginSource (FileName);
  704.    END BeginFile;
  705.  
  706. PROCEDURE yyInitialize;
  707.    BEGIN
  708.       IF yyFileStackPtr >= yyFileStackSize THEN yyErrorMessage (3); END;
  709.       INC (yyFileStackPtr);            (* push file *)
  710.       WITH yyFileStack [yyFileStackPtr] DO
  711.      SourceFile    := yySourceFile        ;
  712.      Eof        := yyEof        ;
  713.      ChBufferPtr    := yyChBufferPtr    ;
  714.      ChBufferStart    := yyChBufferStart    ;
  715.      ChBufferSize    := yyChBufferSize    ;
  716.      ChBufferIndex    := yyChBufferIndex    ;
  717.      BytesRead    := yyBytesRead        ;
  718.      LineCount    := yyLineCount        ;
  719.      LineStart    := yyLineStart        ;
  720.       END;
  721.                         (* initialize file state *)
  722.       yyChBufferSize    := yyInitBufferSize;
  723.       DynArray.MakeArray (yyChBufferPtr, yyChBufferSize, SYSTEM.TSIZE (CHAR));
  724.       yyChBufferStart    := General.MaxAlign;
  725.       yyChBufferPtr^ [yyChBufferStart - 1] := yyEolCh; (* begin of line indicator *)
  726.       yyChBufferPtr^ [yyChBufferStart    ] := yyEobCh; (* end of buffer sentinel *)
  727.       yyChBufferPtr^ [yyChBufferStart + 1] := 0C;
  728.       yyChBufferIndex    := yyChBufferStart;
  729.       yyEof        := FALSE;
  730.       yyBytesRead    := 0;
  731.       yyLineCount    := 1;
  732.       yyLineStart    := yyChBufferStart - 1;
  733.    END yyInitialize;
  734.  
  735. PROCEDURE CloseFile;
  736.    BEGIN
  737.       IF yyFileStackPtr = 0 THEN yyErrorMessage (4); END;
  738.       Source.CloseSource (yySourceFile);
  739.       DynArray.ReleaseArray (yyChBufferPtr, yyChBufferSize, SYSTEM.TSIZE (CHAR));
  740.       WITH yyFileStack [yyFileStackPtr] DO    (* pop file *)
  741.      yySourceFile    := SourceFile        ;
  742.      yyEof        := Eof            ;
  743.      yyChBufferPtr    := ChBufferPtr        ;
  744.      yyChBufferStart:= ChBufferStart    ;
  745.      yyChBufferSize    := ChBufferSize        ;
  746.      yyChBufferIndex:= ChBufferIndex    ;
  747.      yyBytesRead    := BytesRead        ;
  748.      yyLineCount    := LineCount        ;
  749.      yyLineStart    := LineStart        ;
  750.       END;
  751.       DEC (yyFileStackPtr);        
  752.    END CloseFile;
  753.  
  754. PROCEDURE GetWord (VAR Word: Strings.tString);
  755.    VAR i, WordStart    : INTEGER;
  756.    BEGIN
  757.       WordStart := yyChBufferIndex - TokenLength - 1;
  758.       FOR i := 1 TO TokenLength DO
  759.      Word.Chars [i] := yyChBufferPtr^ [WordStart + i];
  760.       END;
  761.       Word.Length := TokenLength;
  762.    END GetWord;
  763.  
  764. PROCEDURE GetLower (VAR Word: Strings.tString);
  765.    VAR i, WordStart    : INTEGER;
  766.    BEGIN
  767.       WordStart := yyChBufferIndex - TokenLength - 1;
  768.       FOR i := 1 TO TokenLength DO
  769.      Word.Chars [i] := yyToLower [yyChBufferPtr^ [WordStart + i]];
  770.       END;
  771.       Word.Length := TokenLength;
  772.    END GetLower;
  773.  
  774. PROCEDURE GetUpper (VAR Word: Strings.tString);
  775.    VAR i, WordStart    : INTEGER;
  776.    BEGIN
  777.       WordStart := yyChBufferIndex - TokenLength - 1;
  778.       FOR i := 1 TO TokenLength DO
  779.      Word.Chars [i] := yyToUpper [yyChBufferPtr^ [WordStart + i]];
  780.       END;
  781.       Word.Length := TokenLength;
  782.    END GetUpper;
  783.  
  784. PROCEDURE yyStart (State: yyStateRange);
  785.    BEGIN
  786.       yyPreviousStart    := yyStartState;
  787.       yyStartState    := State;
  788.    END yyStart;
  789.  
  790. PROCEDURE yyPrevious;
  791.    VAR s    : yyStateRange;
  792.    BEGIN
  793.       s              := yyStartState;
  794.       yyStartState    := yyPreviousStart;
  795.       yyPreviousStart := s;
  796.    END yyPrevious;
  797.  
  798. PROCEDURE yyEcho;
  799.    VAR i    : INTEGER;
  800.    BEGIN
  801.       FOR i := yyChBufferIndex - TokenLength TO yyChBufferIndex - 1 DO
  802.      IO.WriteC (IO.StdOutput, yyChBufferPtr^ [i]);
  803.       END;
  804.    END yyEcho;
  805.  
  806. PROCEDURE yyLess (n: INTEGER);
  807.    BEGIN
  808.       DEC (yyChBufferIndex, TokenLength - n);
  809.       TokenLength := n;
  810.    END yyLess;
  811.  
  812. PROCEDURE yyTab;
  813.    BEGIN
  814.       DEC (yyLineStart, yyTabSpace - 1 - (yyChBufferIndex - yyLineStart - 2) MOD yyTabSpace);
  815.    END yyTab;
  816.  
  817. PROCEDURE yyTab1 (a: INTEGER);
  818.    BEGIN
  819.       DEC (yyLineStart, yyTabSpace - 1 - (yyChBufferIndex - yyLineStart - TokenLength + a - 1) MOD yyTabSpace);
  820.    END yyTab1;
  821.  
  822. PROCEDURE yyTab2 (a, b: INTEGER);
  823.    BEGIN
  824.       DEC (yyLineStart, yyTabSpace - 1 - (yyChBufferIndex - yyLineStart - TokenLength + a - 1) MOD yyTabSpace);
  825.    END yyTab2;
  826.  
  827. PROCEDURE yyEol (Column: INTEGER);
  828.    BEGIN
  829.       INC (yyLineCount);
  830.       yyLineStart := yyChBufferIndex - 1 - Column;
  831.    END yyEol;
  832.  
  833. PROCEDURE output (c: CHAR);
  834.    BEGIN
  835.       IO.WriteC (IO.StdOutput, c);
  836.    END output;
  837.  
  838. PROCEDURE unput (c: CHAR);
  839.    BEGIN
  840.       DEC (yyChBufferIndex);
  841.       yyChBufferPtr^ [yyChBufferIndex] := c;
  842.    END unput;
  843.  
  844. PROCEDURE input (): CHAR;
  845.    BEGIN
  846.       IF yyChBufferIndex = yyChBufferStart + yyBytesRead THEN
  847.      IF NOT yyEof THEN
  848.         DEC (yyLineStart, yyBytesRead);
  849.         yyChBufferIndex := 0;
  850.         yyChBufferStart := 0;
  851.         yyBytesRead := Source.GetLine (yySourceFile, yyChBufferPtr, General.Exp2 (General.Log2 (yyChBufferSize)));
  852.         IF yyBytesRead <= 0 THEN yyBytesRead := 0; yyEof := TRUE; END;
  853.         yyChBufferPtr^ [yyBytesRead    ] := yyEobCh;
  854.         yyChBufferPtr^ [yyBytesRead + 1] := 0C;
  855.      END;
  856.       END;
  857.       IF yyChBufferIndex = yyChBufferStart + yyBytesRead THEN
  858.      RETURN 0C;
  859.       ELSE
  860.      INC (yyChBufferIndex);
  861.      RETURN yyChBufferPtr^ [yyChBufferIndex - 1];
  862.       END
  863.    END input;
  864.  
  865. PROCEDURE BeginScanner;
  866.    BEGIN
  867. (* line 242 "rpp.rex" *)
  868.  
  869. InfoFileName := "Scanner.rpp";
  870. Language := Modula;
  871. IF GetArgCount () > 1 THEN GetArgument (1, ScanTabName); END;
  872. IF GetArgCount () > 2 THEN GetArgument (2, InfoFileName); END;
  873. IsCollecting := FALSE;
  874. InitIdents;
  875. ReadIdents;
  876. AssignEmpty (InsText);
  877. AssignEmpty (StartString);
  878. ArrayToString ("NOT", Not1);
  879. ArrayToString ("'NOT'", Not2);
  880. ArrayToString ('"NOT"', Not3);
  881. ArrayToString ("ANY", Any1);
  882. ArrayToString ("'ANY'", Any2);
  883. ArrayToString ('"ANY"', Any3);
  884.  
  885.    END BeginScanner;
  886.  
  887. PROCEDURE CloseScanner;
  888.    BEGIN
  889.    END CloseScanner;
  890.  
  891. PROCEDURE yyGetTables;
  892.    VAR
  893.       BlockSize, j, n    : CARDINAL;
  894.       TableFile    : System.tFile;
  895.       i        : yyStateRange;
  896.       Base    : ARRAY yyStateRange OF yyTableRange;
  897.    BEGIN
  898.       BlockSize    := 64000 DIV SYSTEM.TSIZE (yyCombType);
  899.       TableFile := System.OpenInput (ScanTabName);
  900.       Checks.ErrorCheck ("yyGetTables.OpenInput", TableFile);
  901.       IF (yyGetTable (TableFile, SYSTEM.ADR (Base      )) DIV SYSTEM.TSIZE (yyTableElmt) - 1 # yyDStateCount) OR
  902.          (yyGetTable (TableFile, SYSTEM.ADR (yyDefault )) DIV SYSTEM.TSIZE (yyTableElmt) - 1 # yyDStateCount) OR
  903.          (yyGetTable (TableFile, SYSTEM.ADR (yyEobTrans)) DIV SYSTEM.TSIZE (yyTableElmt) - 1 # yyDStateCount)
  904.      THEN
  905.      yyErrorMessage (2);
  906.       END;
  907.       n := 0;
  908.       j := 0;
  909.       WHILE j <= yyTableSize DO
  910.          INC (n, yyGetTable (TableFile, SYSTEM.ADR (yyComb [j])) DIV SYSTEM.TSIZE (yyCombType));
  911.          INC (j, BlockSize);
  912.       END;
  913.       IF n # yyTableSize + 1 THEN yyErrorMessage (2); END;
  914.       System.Close (TableFile);
  915.  
  916.       FOR i := 0 TO yyDStateCount DO
  917.      yyBasePtr [i] := LONGCARD (SYSTEM.ADR (yyComb [Base [i]]));
  918.       END;
  919.    END yyGetTables;
  920.  
  921. PROCEDURE yyGetTable (TableFile: System.tFile; Address: SYSTEM.ADDRESS): CARDINAL;
  922.    VAR
  923.       N        : INTEGER;
  924.       Length    : yyTableElmt;
  925.    BEGIN
  926.       N := System.Read (TableFile, SYSTEM.ADR (Length), SYSTEM.TSIZE (yyTableElmt));
  927.       Checks.ErrorCheck ("yyGetTable.Read1", N);
  928.       N := System.Read (TableFile, Address, Length);
  929.       Checks.ErrorCheck ("yyGetTable.Read2", N);
  930.       RETURN Length;
  931.    END yyGetTable;
  932.  
  933. PROCEDURE yyErrorMessage (ErrorCode: SHORTCARD);
  934.    BEGIN
  935.       Positions.WritePosition (IO.StdError, Attribute.Position);
  936.       CASE ErrorCode OF
  937.    | 0: IO.WriteS (IO.StdError, ": Scanner: internal error");
  938.    | 1: IO.WriteS (IO.StdError, ": Scanner: out of memory");
  939.    | 2: IO.WriteS (IO.StdError, ": Scanner: table mismatch");
  940.    | 3: IO.WriteS (IO.StdError, ": Scanner: too many nested include files");
  941.    | 4: IO.WriteS (IO.StdError, ": Scanner: file stack underflow (too many calls of CloseFile)");
  942.       END;
  943.       IO.WriteNl (IO.StdError); Exit;
  944.    END yyErrorMessage;
  945.  
  946. PROCEDURE yyExit;
  947.    BEGIN
  948.       IO.CloseIO; System.Exit (1);
  949.    END yyExit;
  950.  
  951. BEGIN
  952.    ScanTabName        := "Scanner.Tab";
  953.    Exit            := yyExit;
  954.    yyFileStackPtr    := 0;
  955.    yyStartState        := 1;            (* set up for auto init *)
  956.    yyPreviousStart    := 1;
  957.    yyBasePtr [yyStartState] := LONGCARD (SYSTEM.ADR (yyComb [0]));
  958.    yyDefault [yyStartState] := yyDNoState;
  959.    yyComb [0].Check    := yyDNoState;
  960.    yyChBufferPtr    := SYSTEM.ADR (yyComb [0]);    (* dirty trick *)
  961.    yyChBufferIndex    := 1;                (* dirty trick *)
  962.    yyStateStackSize    := yyInitBufferSize;
  963.    DynArray.MakeArray (yyStateStack, yyStateStackSize, SYSTEM.TSIZE (yyStateRange));
  964.    yyStateStack^ [0]    := yyDNoState;
  965.    
  966.    FOR yyCh := yyFirstCh TO yyLastCh DO yyToLower [yyCh] := yyCh; END;
  967.    yyToUpper := yyToLower;
  968.    FOR yyCh := 'A' TO 'Z' DO
  969.       yyToLower [yyCh] := CHR (ORD (yyCh) - ORD ('A') + ORD ('a'));
  970.    END;
  971.    FOR yyCh := 'a' TO 'z' DO
  972.       yyToUpper [yyCh] := CHR (ORD (yyCh) - ORD ('a') + ORD ('A'));
  973.    END;
  974. END Scanner.
  975.